home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d27 / backli2.arc / BACKLIST.ASC next >
Encoding:
Text File  |  1990-07-23  |  9.8 KB  |  237 lines
  1. 10 'BACKLIST.bas    List names of files on Backup Disk
  2. 20 'SAVE"backlist.bas"
  3. 30 DIM PRT$(200) : KEY OFF
  4. 40 COLOR 7,1:CLS
  5. 50 '----- prompt for input -----
  6. 60 LOCATE 1,1:PRINT "BACKLIST (Ver 2.0) - Display Directories/Files on DOS 3.3 Backup Disks";
  7. 70 LOCATE 2,1:PRINT "         Jim Imbrogno - (216) 447-1600 Cleveland, Ohio";
  8. 80 LOCATE 5,15:PRINT "Enter Drive Letter: ";
  9. 90 DR$=INKEY$:IF DR$="" THEN GOTO 90
  10. 100 IF ASC(DR$) > 96 THEN DR$=CHR$(ASC(DR$)-32)  'convert to Upper Case
  11. 110 LOCATE 5,35:PRINT DR$;
  12. 120 LOCATE 7,15:PRINT "Press <F> to display File Names, or";
  13. 130 LOCATE 8,15:PRINT "Press <D> to display Directory Names ONLY";
  14. 140 TYPE$=INKEY$:IF TYPE$="" THEN GOTO 140
  15. 150 IF ASC(TYPE$) > 96 THEN TYPE$=CHR$(ASC(TYPE$)-32)  'convert to Upper Case
  16. 160 IF TYPE$ <> "D" AND TYPE$ <> "F" THEN SOUND 2500,.5 :GOTO 120
  17. 170 LOCATE 10,15:PRINT "Press <P> to send report to PRINTER";
  18. 180 LOCATE 11,15:PRINT "Press any other key to show report on SCREEN";
  19. 190 DEVICE$=INKEY$:IF DEVICE$="" THEN GOTO 190
  20. 200 IF ASC(DEVICE$) > 96 THEN DEVICE$=CHR$(ASC(DEVICE$)-32)  'convert to Upper Case
  21. 210 IF DEVICE$="P" THEN OPEN "LPT1:" FOR OUTPUT AS #2 ELSE OPEN "SCRN:" FOR OUTPUT AS #2
  22. 220 '----------------------------------------------------------------------
  23. 230 FILE$=DR$+":CONTROL.*"
  24. 240 ITEM%=0
  25. 250 ON ERROR GOTO 2130
  26. 260 CLS:LOCATE 1,1:FILES FILE$:NBR$=""
  27. 270 IF E%=53 GOTO 1860 'File not found
  28. 280 'IF E%=57 GOTO 890 'Device I/O error
  29. 290 FOR X%=10 TO 12
  30. 300 NBR$=NBR$+CHR$(SCREEN(2,X%))   'get backup disk number
  31. 310 NEXT X%
  32. 320 FILE$=DR$+":CONTROL."+NBR$     'complete file name
  33. 330 DISK%=VAL(NBR$)                'disk number
  34. 340 '----- display Header -----
  35. 350 CLS:COLOR 7,1
  36. 360 LOCATE 1,1:PRINT "BACKLIST (Ver 2.0) - Display Directories/Files on DOS 3.3 Backup Disks";
  37. 370 LOCATE 2,1:PRINT "         Jim Imbrogno - (216) 447-1600 Cleveland, Ohio";
  38. 380 LOCATE 3,5:PRINT "Drive: ";:LOCATE 3,12:COLOR 14,0:PRINT DR$;:COLOR 7,1:LOCATE 3,16:PRINT "Disk #: ";:COLOR 14,0:PRINT NBR$;:COLOR 7,1
  39. 390 IF DEVICE$ <> "P" THEN GOTO 440
  40. 400 PRINT #2,"__________________"
  41. 410 PRINT #2,"BACKLIST (Ver 2.0) - Display Directories/Files on DOS 3.3 Backup Disks"
  42. 420 PRINT #2,"Drive: ";DR$;"   Disk #: ";NBR$
  43. 430 LOCATE 7,15:COLOR 15,1:PRINT " Sending output to PRINTER ";:COLOR 7,1
  44. 440 LOCATE 5,1
  45. 450 '----- read data in CONTROL.nnn file -----
  46. 460 OPEN "R",#1,FILE$,1
  47. 470 IF E%=53 GOTO 1860 'File not found
  48. 480 FIELD 1,1 AS F$
  49. 490 BYTES=LOF(1)
  50. 500 R%=0
  51. 510 '
  52. 520 '----- process HEADER Record -----
  53. 530 RECD$=SPACE$(139)        'init record workspace
  54. 540 FOR X%=1 TO 139
  55. 550 R%=R%+1 : IF R% > BYTES THEN GOTO 1860  'EOJ
  56. 560 GET 1,R%                 'read next byte
  57. 570 MID$(RECD$,X%,1) = F$    'load workspace
  58. 580 NEXT X%
  59. 590 ITEM%=ITEM%+1
  60. 600 PRT$(ITEM%)=RECD$        'put workspace record in array
  61. 610 GOSUB 1790                'output results
  62. 620 '
  63. 630 '----- MAINLINE Loop - Process the rest of the CONTROL.nnn file -----
  64. 640 IF R%+1 > BYTES THEN GOTO 1860   'EOJ
  65. 650 GET 1,R%+1                      'read next byte
  66. 660 IF F$="F" THEN GOSUB 760 : GOTO 700 '(Directory Record)
  67. 670 IF F$=CHR$(34) AND TYPE$="F" THEN GOSUB 870 :GOTO 700  'chr$(34) = "  (File Rec)
  68. 680 IF F$=CHR$(34) AND TYPE$="D" THEN R%=R%+34:ITEM%=ITEM%+1:PRT$(ITEM%)=F$ :GOTO 700 'skip over File Rec
  69. 690 STOP:R%=R%+1 : GOTO 630   'if didn't detect Directory or File record, then increment byte & loop back
  70. 700 'sub-routine processed some data, now output the results
  71. 710 GOSUB 1790                'output results
  72. 720 GOTO 630   'loop back (R% was incremented in the sub-routines
  73. 730 '==========================================================================
  74. 740 '   SUB-ROUTINES
  75. 750 '==========================================================================
  76. 760 '===== Process DIRECTORY Record =====
  77. 770 RECD$=SPACE$(70)      'init work space
  78. 780 FOR X%=1 TO 70        'for each byte
  79. 790 R%=R%+1 : IF R% > BYTES THEN GOTO 1860
  80. 800 GET 1,R%              'read a byte
  81. 810 MID$(RECD$,X%,1) = F$ 'build record workspace
  82. 820 NEXT X%
  83. 830 '
  84. 840 ITEM%=ITEM%+1         'index for PRT$ array
  85. 850 PRT$(ITEM%)=RECD$     'put workspace into array
  86. 860 RETURN
  87. 870 '===== Process FILE Record =====
  88. 880 RECD$=SPACE$(34)
  89. 890 FOR X%=1 TO 34
  90. 900 R%=R%+1 : IF R% > BYTES THEN GOTO 1860
  91. 910 GET 1,R%
  92. 920 IF X% > 1 AND X% < 14 THEN IF F$=CHR$(0) THEN LSET F$=CHR$(32)   'replace null with space, only in FILE NAME part of file
  93. 930 MID$(RECD$,X%,1) = F$
  94. 940 NEXT X%
  95. 950 ITEM%=ITEM%+1
  96. 960 PRT$(ITEM%)=RECD$
  97. 970 S1$=MID$(PRT$(ITEM%),15,4)   'Size #1
  98. 980 S2$=MID$(PRT$(ITEM%),25,4)   'Size #2
  99. 990 T$=MID$(PRT$(ITEM%),31,2)   'Time
  100. 1000 D$=MID$(PRT$(ITEM%),33,2)   'Date
  101. 1010 B1 = ASC(MID$(T$,2,1))  :  B2 = ASC(MID$(T$,1,1))   'get values & flip bytes
  102. 1020 HH=0   'init
  103. 1030 HH= HH + ((B1 AND 128)/8)
  104. 1040 HH= HH + ((B1 AND 64)/8)
  105. 1050 HH= HH + ((B1 AND 32)/8)
  106. 1060 HH= HH + ((B1 AND 16)/8)
  107. 1070 HH= HH + ((B1 AND 8)/8)
  108. 1071 AP$="am":IF HH >= 12 THEN AP$="pm"  'AM or PM
  109. 1072 IF HH > 12 THEN HH=HH-12   'convert from 24hr clock
  110. 1073 IF HH < 10 THEN HH$=" "+MID$(STR$(HH),2,1) ELSE HH$=MID$(STR$(HH),2,2)
  111. 1080 MM=0   'init
  112. 1090 MM= MM + ((B1 AND 4)*8)
  113. 1100 MM= MM + ((B1 AND 2)*8)
  114. 1110 MM= MM + ((B1 AND 1)*8)
  115. 1120 MM= MM + ((B2 AND 128)/32)
  116. 1130 MM= MM + ((B2 AND 64)/32)
  117. 1140 MM= MM + ((B2 AND 32)/32)
  118. 1142 IF MM < 10 THEN MM$="0"+MID$(STR$(MM),2,1) ELSE MM$=MID$(STR$(MM),2,2)
  119. 1150 SS=0   'init
  120. 1160 SS= SS + (B2 AND 16)
  121. 1170 SS= SS + (B2 AND 8)
  122. 1180 SS= SS + (B2 AND 4)
  123. 1190 SS= SS + (B2 AND 2)
  124. 1200 SS= SS + (B2 AND 1)
  125. 1210 SS= SS * 2    'stored in 2-second increments
  126. 1212 IF SS < 10 THEN SS$=" "+MID$(STR$(SS),2,1) ELSE SS$=MID$(STR$(SS),2,2)
  127. 1215 HMS$=HH$+":"+MM$   '+":"+SS$  '(seconds not needed)
  128. 1220 B1 = ASC(MID$(D$,2,1))  :  B2 = ASC(MID$(D$,1,1))   'get values & flip bytes
  129. 1230 YR=1980   'init (to base year)
  130. 1240 YR= YR + ((B1 AND 128)/2)
  131. 1250 YR= YR + ((B1 AND 64)/2)
  132. 1260 YR= YR + ((B1 AND 32)/2)
  133. 1270 YR= YR + ((B1 AND 16)/2)
  134. 1280 YR= YR + ((B1 AND 8)/2)
  135. 1290 YR= YR + ((B1 AND 4)/2)
  136. 1300 YR= YR + ((B1 AND 2)/2)
  137. 1302 YR$=MID$(STR$(YR),4,2)
  138. 1310 MO=0   'init
  139. 1320 MO= MO + ((B1 AND 1)*8)
  140. 1330 MO= MO + ((B2 AND 128)/32)
  141. 1340 MO= MO + ((B2 AND 64)/32)
  142. 1350 MO= MO + ((B2 AND 32)/32)
  143. 1352 IF MO < 10 THEN MO$=" "+MID$(STR$(MO),2,1) ELSE MO$=MID$(STR$(MO),2,2)
  144. 1360 DA=0   'init
  145. 1370 DA= DA + (B2 AND 16)
  146. 1380 DA= DA + (B2 AND 8)
  147. 1390 DA= DA + (B2 AND 4)
  148. 1400 DA= DA + (B2 AND 2)
  149. 1410 DA= DA + (B2 AND 1)
  150. 1412 IF DA < 10 THEN DA$=" "+MID$(STR$(DA),2,1) ELSE DA$=MID$(STR$(DA),2,2)
  151. 1415 MDY$=MO$+"-"+DA$+"-"+YR$
  152. 1420 B1 = ASC(MID$(S1$,4,1))  :  B2 = ASC(MID$(S1$,3,1)) : B3 = ASC(MID$(S1$,2,1)) : B4 = ASC(MID$(S1$,1,1))  'get values & flip bytes
  153. 1430 SZ=0   'init
  154. 1440 SZ= SZ + ((B1 AND 128) * 2^24)
  155. 1450 SZ= SZ + ((B1 AND 64) * 2^24)
  156. 1460 SZ= SZ + ((B1 AND 32) * 2^24)
  157. 1470 SZ= SZ + ((B1 AND 16) * 2^24)
  158. 1480 SZ= SZ + ((B1 AND 8) * 2^24)
  159. 1490 SZ= SZ + ((B1 AND 4) * 2^24)
  160. 1500 SZ= SZ + ((B1 AND 2) * 2^24)
  161. 1510 SZ= SZ + ((B1 AND 1) * 2^24)
  162. 1520 SZ= SZ + ((B2 AND 128) * 2^16)
  163. 1530 SZ= SZ + ((B2 AND 64) * 2^16)
  164. 1540 SZ= SZ + ((B2 AND 32) * 2^16)
  165. 1550 SZ= SZ + ((B2 AND 16) * 2^16)
  166. 1560 SZ= SZ + ((B2 AND 8) * 2^16)
  167. 1570 SZ= SZ + ((B2 AND 4) * 2^16)
  168. 1580 SZ= SZ + ((B2 AND 2) * 2^16)
  169. 1590 SZ= SZ + ((B2 AND 1) * 2^16)
  170. 1600 SZ= SZ + ((B3 AND 128) * 2^8)
  171. 1610 SZ= SZ + ((B3 AND 64) * 2^8)
  172. 1620 SZ= SZ + ((B3 AND 32) * 2^8)
  173. 1630 SZ= SZ + ((B3 AND 16) * 2^8)
  174. 1640 SZ= SZ + ((B3 AND 8) * 2^8)
  175. 1650 SZ= SZ + ((B3 AND 4) * 2^8)
  176. 1660 SZ= SZ + ((B3 AND 2) * 2^8)
  177. 1670 SZ= SZ + ((B3 AND 1) * 2^8)
  178. 1680 SZ= SZ +  (B4 AND 128)
  179. 1690 SZ= SZ +  (B4 AND 64)
  180. 1700 SZ= SZ +  (B4 AND 32)
  181. 1710 SZ= SZ +  (B4 AND 16)
  182. 1720 SZ= SZ +  (B4 AND 8)
  183. 1730 SZ= SZ +  (B4 AND 4)
  184. 1740 SZ= SZ +  (B4 AND 2)
  185. 1750 SZ= SZ +  (B4 AND 1)
  186. 1760 'IF MID$(PRT$(ITEM%),2,9)="DUMMY.TXT" THEN STOP
  187. 1770 'PRINT "hex: ";HEX$(ASC(MID$(s1$,4,1)));" ";HEX$(ASC(MID$(s1$,3,1)));" ";hex$(asc(mid$(s1$,2,1)));" ";hex$(asc(mid$(s1$,1,1)))
  188. 1780 RETURN
  189. 1790 '----- Display/Print Results
  190. 1800 IF ITEM%=1 THEN COLOR 14,0:PRINT #2,"[Header] ";MID$(PRT$(ITEM%),2,6);:COLOR 7,1:PRINT: GOTO 1850
  191. 1810 IF MID$(PRT$(ITEM%),1,1)="F" THEN PRINT #2," ":COLOR 14,0:PRINT #2,"[Dir] ";:COLOR 12,0:PRINT #2,MID$(PRT$(ITEM%),2,63)
  192. 1820 'IF MID$(PRT$(ITEM%),1,1)="F" AND TYPE$="D" THEN COLOR 7,1:PRINT #2," "
  193. 1830 IF MID$(PRT$(ITEM%),1,1)=CHR$(34) AND TYPE$="F" THEN COLOR 7,1:PRINT #2,MID$(PRT$(ITEM%),2,12);"   ";SZ,MDY$,HMS$;AP$; "  (approximate time)
  194. 1840 IF MID$(PRT$(ITEM%),1,1)=CHR$(34) AND TYPE$="D" THEN PRINT #2,".";
  195. 1850 RETURN
  196. 1860 '----- EOJ - Prompt for more -----
  197. 1870 CLOSE 1
  198. 1880 COLOR 7,1:PRINT:PRINT
  199. 1890 SOUND 2500,.5
  200. 1900 LOCATE 24,15:PRINT "Process another disk? (Y/N)";
  201. 1910 LOCATE 24,43 : MORE$=INKEY$:IF MORE$="" THEN GOTO 1910
  202. 1920 IF ASC(MORE$) > 96 THEN MORE$=CHR$(ASC(MORE$)-32)  'convert to Upper Case
  203. 1930 IF MORE$ = "Y" THEN GOTO 230
  204. 1940 IF MORE$ <> "N" THEN GOTO 1890
  205. 1950 IF DEVICE$="P" THEN PRINT #2,CHR$(12);
  206. 1960 CLOSE 2
  207. 1970 END   '<======
  208. 1980 '===== get date & time ===================
  209. 1990 '===== (this test routine is never called)
  210. 2000 FOR X%= 0 TO 15
  211. 2010 PRINT X%;"=";2^X%
  212. 2020 NEXT X%
  213. 2030 F$=MKI$(5257)
  214. 2040 PRINT HEX$(ASC(MID$(F$,1,1)));" ";HEX$(ASC(MID$(F$,2,1)))
  215. 2050 T%=5257  :DIM PRT2$(16)
  216. 2060 FOR X%=1 TO 16
  217. 2070 PRT2$(X%)="0"
  218. 2080 'PRINT X%,2^(X%-1)
  219. 2090 IF (T% AND 2^(X%-1)) <> 0 THEN PRT2$(X%)="1"
  220. 2100 PRINT PRT2$(X%);" ";
  221. 2110 NEXT X%
  222. 2120 RETURN
  223. 2130 '===== trap for File error =====
  224. 2140 E% = ERR
  225. 2150 ERRCNT%=ERRCNT% + 1   'TO PREVENT RECURSIVE ERROR LOOPING
  226. 2160 IF ERRCNT% = 1 THEN GOTO 2180
  227. 2170 END   'EXCESSIVE ERRORS; ABORT
  228. 2180 'PRINT ERR:STOP   'DEBUG
  229. 2190 IF E%<>53 THEN GOTO 2250
  230. 2200 'ERROR 53; NO MATCH ON FILE SPEC
  231. 2210 LOCATE 10,15:PRINT "NO BACKUP FILES FOUND. PRESS ANY KEY TO CONTINUE";
  232. 2220 X$=INKEY$:IF X$="" THEN GOTO 2220
  233. 2230 ERRCNT%=0
  234. 2240 'BEEP:TRON:LOCATE 24,1
  235. 2250 'PRINT ERR:STOP
  236. 2260 RESUME NEXT
  237.